Tech Arsenal 1/Tech Arsenal (Arsenal Computer).ISO/tek-03/qbnws303.zip/TEXTFONT.ZIP/FONTDEMO.BAS

BASIC Source File | 1992-09-15 | 33KB | 1,077 lines

DEFINT A-Z


'========================================================================
'
'   FontDemo.Bas        (by Rob Smetana for QBNews, 9/92)
'                       (In case you have questions:  [phone])
'
'   You MUST run this loading either Fonts7.QLB (QBX) or
'   Fonts45.QLB (QB 4.x).  This demo needs screen font files
'   contained in those Quick Libraries.  We also need the
'   InterruptX routines.
'
'   If you use QBX/BC 7:        qbx fontdemo /L fonts7
'     If you use QB 4.x:        qb  fontdemo /L fonts45
'
'   We also included Fonts.Lib -- with the Tiny, Script and Roman fonts.
'   You can use it with either QB or PDS, once you've added it to your
'   own LIB or QLB files.  For example:
'
'   PDS:  Link /q/seg:512  MyLib.Lib Fonts.Lib, SomeQLB, nul, QBXQLB;
'   QB:   Link /q/seg:512  MyLib.Lib Fonts.Lib, SomeQLB, nul, BQLB45;
'
'
'========================================================================
'                    ---  NOTE USERS of QB 4.x  ---
'========================================================================
'
' BEFORE you run this, move to SUB LoadFontFile and COMMENT OUT the line:
'
'                       Registers.ES = SSEG(a$)
'
'    If you don't do this, you'll get an "Array Not Defined" error.
'
'========================================================================

TYPE RegTypeX                           ' TYPE required by InterruptX
     AX    AS INTEGER
     BX    AS INTEGER
     CX    AS INTEGER
     DX    AS INTEGER
     BP    AS INTEGER
     SI    AS INTEGER
     DI    AS INTEGER
     Flags AS INTEGER
     DS    AS INTEGER
     ES    AS INTEGER
END TYPE

DIM SHARED Registers AS RegTypeX        ' For Call InterruptX ...

DECLARE SUB InterruptX (Interrupt, InRegs AS RegTypeX, OutRegs AS RegTypeX)
DECLARE SUB LoadFontFile (FontFile$, CharWidth%, FirstChar%, NumberChars%, UsingFarStrings%)
DECLARE SUB RestoreDefault (WhichMonitor)
DECLARE SUB ToggleSize (Which%)
DECLARE SUB Sideways.Logo ()
DECLARE SUB PauseTicks (Ticks%)
DECLARE SUB Demonstrate.Symbols ()
DECLARE SUB Demonstrate.Loading.Fonts ()
DECLARE SUB Demo.CALLing.Fonts ()
DECLARE SUB Demo.text.AND.graphics ()

DECLARE FUNCTION QB.Monitor% (ScrnRows%)
DECLARE FUNCTION PressKey$ (Row%, Col%, Action%)

PressAKey$ = " Press any key to continue... "      '...used in several places


'====== "SCREEN , 0" helps ensure QB/QBX restore a normal font when you
'       return to the environment.  This comes in v-e-r-y handy when
'       you start experimenting and render your screen unreadable!
'       Note:  That's NOT Screen 0!

    SCREEN , 0

    COLOR 11, 1
    CLS
    WIDTH , 25                          '...DON'T change this!  43- or 50-
                                        '   line modes will truncate char-
                                        '   acters.  (OK Rick, try 43 or 50
                                        '   and see what I mean.)

'=========================================================================
'... Determine monitor type.  We "should" only proceed if EGA/VGA detected.
'=========================================================================

    WhichMonitor = QB.Monitor(LastRow)  '...note:  returns 2 values
                                        '   we won't use LastRow, but
                                        '   you might find it helpful
    SELECT CASE WhichMonitor
        CASE 3, 4                       '...EGA- or VGA-compatible
        CASE ELSE
             PRINT
             PRINT "This demo should be run on an EGA or VGA monitor.  You CAN proceed,"
             PRINT "but you'll miss most of the good parts, and some things won't work."
             PRINT "Press Ctrl-Break now if you'd like to stop.";
             a$ = INPUT$(1)
    END SELECT


'========================================================================
'... Display one of our logos
'========================================================================

    Sideways.Logo

    COLOR 11, 1: CLS

    RestoreDefault WhichMonitor

'========================================================================
'... demonstrate how easy it is to change text fonts by CALLing FontName
'========================================================================

    Demo.CALLing.Fonts


    '... By NOT restoring the default font, you'll see how you can
    '    switch fonts, then remap some characters in the NEW font.
    '    UN-REM the next line to re-set the font BEFORE the next demo.

    'RestoreDefault WhichMonitor

'========================================================================
'... demonstrate different types of symbols one can create
'========================================================================

    Demonstrate.Symbols

    RestoreDefault WhichMonitor

'========================================================================
'... demonstrate how to load fonts FROM DISK
'========================================================================

    Demonstrate.Loading.Fonts

    RestoreDefault WhichMonitor


'========================================================================

    CLS
    PRINT
    PRINT "  Finally, you can switch among the 2-3 fonts you already have.  Here we'll"
    PRINT "  switch to the small 8x8 font.  Both EGA and VGA monitors also have an"
    PRINT "  8x14 font.  VGA monitors also have an 8x16 font."

'========================================================================

    LOCATE 6, 1
    FOR x = 1 TO 10
        PRINT " We'll now switch to the small 8x8 font available on both EGA and VGA monitors."
    NEXT

    CALL ToggleSize(2)              'Option MUST be: 1 (8x14) 2 (8x8) or 4 (8x16 -- VGA only)

    a$ = PressKey$(22, 25, 0)


    CLS

    RestoreDefault WhichMonitor

'========================================================================
'... Display an ASM/OBJ screen created with P-Screen, then end.
'========================================================================

    CLS

    CALL ThatsAll

    LOCATE 20, 1
    PRINT "  Be SURE to run Adv-Demo.Exe.  It demonstrates:"
    PRINT "   1.  How you can use the same fonts in both text AND graphics modes."
    PRINT "   2.  How VERY SIMPLE font changes can change the SHAPE of the MOUSE CURSOR."
    PRINT "       Just re-map a character, then:  "
    PRINT "            CALL SetTextCursor (Foreground, Background, WhichCharacter)!"

    a$ = PressKey$(25, 25, 0)

'========================================================================

END


LogoBox:       '...used in our sideways logo demo

DATA "┌───────────────────────────────────────┐"
DATA "│                                       │"
DATA "│   ┌───────────────────────────────┐   │"
DATA "│   │                               │   │"
DATA "│   │                               │   │"
DATA "│   │                               │   │"
DATA "│   │                               │   │"
DATA "│   │                               │   │"
DATA "│   │                               │   │"
DATA "│   │                               │   │"
DATA "│   │                               │   │"
DATA "│   │                               │   │"
DATA "│   │                               │   │"
DATA "│   │                               │   │"
DATA "│   │                               │   │"
DATA "│   └───────────────────────────────┘   │"
DATA "│                                       │"
DATA "└───────────────────────────────────────┘"

'
SUB Demo.CALLing.Fonts

    SHARED PressAKey$

'========================================================================

PRINT TAB(34); "Text Font Demo":

PRINT : PRINT
PRINT "      Next we'll show how easy it is to CALL [font name] to change the "
PRINT "      appearance of screens by simply switching fonts.  "
PRINT
PRINT "      NOTE:  We'll be CALLing fonts created by Font2ASM -- which we included"
PRINT "      here for your use.  Just assemble the ASM files, LINK the fonts to your"
PRINT "      programs, then just CALL .... to use them."

LOCATE 24, 47: PRINT PressAKey$; "  "; : a$ = INPUT$(1)

'========================================================================


LOCATE 3, 1
GOSUB DisplayDemo                           '===== 1st, display some text
LOCATE 24, 5: PRINT "This is your normal text font.";
a$ = INPUT$(1)


                                            '===== 2nd, switch fonts

LOCATE 24, 5: PRINT "CALL TINY -- our Tiny Font.   ";
    CALL Tiny
    Action = 0                              '===== Display scrolling "Press ..."
                                            'Action = 0 ==> Take control
                                            'and wait for key.
    a$ = PressKey$(24, 47, Action)


LOCATE 24, 5: PRINT "CALL ROMAN14 -- our Roman Font.";
    CALL Roman14: a$ = PressKey$(24, 47, 0)


LOCATE 24, 5: PRINT "CALL SCRIPT -- our Script Font.";
    CALL Script: a$ = PressKey$(24, 47, 0)


EXIT SUB


'========================
DisplayDemo:
'========================
d$ = " "
PRINT d$; " ┌─░░░░░░░░░▒▒▒▒▒▒▒▒▒▒▒▓▓▓▓▓▓▓▓▓▓▓ FONT DEMO ▓▓▓▓▓▓▓▓▓▓▓▒▒▒▒▒▒▒▒▒▒▒░░░░░░░░─┐"
PRINT d$; "░│                                                                          │"
PRINT d$; "░│                                                                          │"
PRINT d$; "░│ We are NOT displaying different screens!  We'll display this once. Then, │"
PRINT d$; "░│ as we load different fonts, the appearance changes.  Fonts remain in     │"
PRINT d$; "░│ effect until you select another, or until a program changes screen modes.│"
PRINT d$; "░│                                                                          │"
PRINT d$; "░│ Notice that we will NOT replace all characters -- just ASCII 33 to 127.  │"
PRINT d$; "░│ Why?  To keep fonts small, and because we really don't want to change    │"
PRINT d$; "░│ the line-draw and shading characters.                                    │"
PRINT d$; "░│                                                                          │"
PRINT d$; "░│   +------+-----+  Now is the time for all good men to come to the aid... │"
PRINT d$; "░│   |      |     |  ABCDEFGHIJKLMNOPQRSTUVWXYZ  abcdefghijklmnopqrstuvwxyz │"
PRINT d$; "░│   +------+-----+                                                         │"
PRINT d$; "░│                                                                          │"
PRINT d$; "░│ 1234567890 -=!@#$%^&*()_+[] {};'<>?,./\|~`ÇüéâäàåçêëèïîìÄÅÉæÆôöòûùÿÖÜ¢£¥ │"
PRINT d$; "░│                                                                          │"
PRINT d$; "░│           ₧ƒáíóúñѪº¿⌐¬½¼¡«»        αßΓπΣσµτΦΩδ∞φε∩≡±≥≤⌠⌡÷≈°∙·√ⁿ²■       │"
PRINT d$; "░└──────────────────────────────────────────────────────────────────────────┘"
PRINT d$; "░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░";

RETURN


END SUB

'
SUB Demonstrate.Loading.Fonts

    SHARED PressAKey$

'========================================================================

CLS
PRINT
PRINT "   Next, we'll load some fonts from disk.  To do this we need to know"
PRINT "   whether you're using QB or QBX."
PRINT
PRINT "   NOTE, the font files MUST exist on the current drive/directory."
PRINT "   We WON'T check.  So ensure ULine.14 and Italics.14 are here."

'========================================================================


'====== Sub LoadFontFile must know whether Near or Far strings are being used.

UsingFarStrings = 0                         ' assume we're using QB 4.x

DO

    LOCATE 12, 1, 1
    PRINT "   Please answer this CORRECTLY!  Press 7 or 4 ONLY."
    PRINT
    PRINT "   Are you using QB 4.x or QBX/BC7 with Far Strings?  Press (4) or (7) --> ";

    BEEP

    a$ = INPUT$(1)


LOOP UNTIL a$ = "7" OR a$ = "4"

IF a$ = "7" THEN UsingFarStrings = -1       ' we need this in LoadFontFile


GOSUB Demonstrate.Underlined.Text

GOSUB Demonstrate.Italic.Text


EXIT SUB

'==============================================================
Demonstrate.Underlined.Text:
'==============================================================

FontFile$ = "ULine.14"

a$ = "An example of UNDERLINED text."

GOSUB SetUp.For.Examples

a$ = "UNDERLINED, all you have to do is print   HIGH ASCII characters (in this example)."

GOSUB PrintAsHighAscii

GOSUB TranslatePressAKey

RETURN
'==============================================================
Demonstrate.Italic.Text:
'==============================================================

FontFile$ = "Italics.14"

a$ = "An example of ITALIC text . . ."

GOSUB SetUp.For.Examples

a$ = "in ITALICS, all you have to do is print   HIGH ASCII characters (in this example)."

GOSUB PrintAsHighAscii

GOSUB TranslatePressAKey

RETURN

'==============================================================
SetUp.For.Examples:
'==============================================================

'===== Both of our sample font files have 64 characters (the basics).
'      Each character's bit map is 14 bytes, and we'll load 'em high
'      (ie., we'll replace ASCII characters 128 +).

NumberChars = 64: CharWidth = 14: FirstChar = 128

CALL LoadFontFile(FontFile$, CharWidth, FirstChar, NumberChars, UsingFarStrings)

CLS
PRINT TAB(24);
GOSUB PrintAsHighAscii                      '...print our title
COLOR 15, 1
PRINT : PRINT : PRINT : PRINT
PRINT " You can print NORMAL text."
PRINT : PRINT
PRINT " And you can 'mix-and-match' characters -- by re-mapping only some characters"
PRINT " (eg., 1-31 or 128+), and then ....  well, you'll see."
PRINT : PRINT

PRINT " For example, if you want text printed ";
COLOR 7, 1
RETURN


'==============================================================
PrintAsHighAscii:   '...We replaced high ASCII characters with
'                   '   Italic or Underline characters.  To
                    '   use these, we simply add 64 to the
                    '   ASCII value of each character -- since
                    '   we load our fonts 64 characters higher
                    '   than normal.
'==============================================================

FOR x = 1 TO LEN(a$)

    Which = ASC(MID$(a$, x))
    IF Which > 64 THEN Which = Which + 64    '... "A" and above
    PRINT CHR$(Which);

NEXT

RETURN

'==============================================================
TranslatePressAKey:
'==============================================================

    LOCATE 22, 25

    a$ = PressAKey$

    GOSUB PrintAsHighAscii

    a$ = INPUT$(1)

RETURN

END SUB

'
SUB Demonstrate.Symbols

CLS

    CALL Symbols                '... load our Symbol font

    GOSUB DisplaySymbols        '... show examples of symbols you can create

    GOSUB LargeSymbols          '... and even larger symbols

    GOSUB ShowHand              '... pointer to words

    CLS : COLOR 14

EXIT SUB


'====================================================
DisplaySymbols:     '... illustrate several symbols
'====================================================


    Char = 14: b$ = "How about a Copyright Symbol!"
        GOSUB DoSymbol

    Char = 15: b$ = "Or a Registered Trademark Symbol!"
        GOSUB DoSymbol

    Char = 16: b$ = "Or a TEXT-MODE Pointing Hand Cursor!"
        GOSUB DoSymbol

RETURN

'====================================================
DoSymbol:
'====================================================

    CLS
    COLOR 14
    LOCATE , 40 - (LEN(b$) \ 2) + 1
    PRINT b$

    PRINT
    COLOR 10

    b$ = " " + CHR$(Char)
    FOR x = 1 TO 800: PRINT b$; : NEXT

    CALL PauseTicks(60)

RETURN

'====================================================
LargeSymbols:   '... demo how one might create LARGE symbols
'====================================================

'...Display our large P~F Logo.  We'll create 3 characters out of 7.

    COLOR 14
    CLS : PRINT

    FirstLine$ = CHR$(17) + CHR$(18) + CHR$(19) + CHR$(20) + CHR$(21)
    Line2$ = CHR$(22) + "  " + CHR$(23)

    PRINT TAB(14); "You can print LARGE characters or symbols in TEXT mode!"
    PRINT : PRINT : PRINT

    FOR x = 1 TO 6
        PRINT "      "; FirstLine$; "    "; FirstLine$; "    "; FirstLine$; "    "; FirstLine$; "    "; FirstLine$; "    "; FirstLine$; "    "; FirstLine$; "    "; FirstLine$
        PRINT "      "; Line2$; "     "; Line2$; "     "; Line2$; "     "; Line2$; "     "; Line2$; "     "; Line2$; "     "; Line2$; "     "; Line2$
        PRINT
    NEXT

    CALL PauseTicks(60)

RETURN

'====================================================
ShowHand:   '... use hand symbol to track words
'====================================================

    CLS

    b$ = "Now please follow along, follow along, follow along ..... "


    Row = 10
    Pointer$ = CHR$(16)             '...our pointing hand

    FOR DoTwice = 1 TO 2
        Start = 1
        LOCATE Row, 10
        TotalWordLength = 0

        DO UNTIL Start > LEN(b$)

            WordLength = INSTR(Start, b$, " ") - Start + 1

            '... find & print each word
            Word$ = MID$(b$, Start, WordLength)

            LOCATE Row, 10 + TotalWordLength + 1

            COLOR 14
            PRINT Word$;

            TotalWordLength = TotalWordLength + WordLength

            '... locate beneath the word and print our Pointing Hand
            LOCATE Row + 1, (POS(0) - WordLength \ 2) - 1
            COLOR 2
            PRINT Pointer$;

            CALL PauseTicks(8)

            Start = Start + WordLength

        LOOP
        Row = Row + 4

        CALL PauseTicks(25)

    NEXT

    CALL PauseTicks(60)


RETURN

END SUB

'
SUB LoadFontFile (FontFile$, CharWidth, FirstChar, NumberChars, UsingFarStrings)


    '====== Replace the EGA or VGA font by loading an on-disk font file.

    '       "Registers" is a SHARED TYPE  (DIM SHARED Registers as RegTypeX).


    FontFile = FREEFILE

    OPEN FontFile$ FOR BINARY AS #FontFile


    a$ = SPACE$(LOF(FontFile))        ' To load the entire font in one gulp

    GET #FontFile, , a$               ' Read the font
    CLOSE #FontFile


    '====== 1st, describe our font:  # of Characters, width, where to begin

    Registers.CX = NumberChars        ' Number of chars in our font file

    Registers.BX = CharWidth * 256 + Which   ' BH = # of bytes in each character's
                                      ' bit map (eg., 8, 14, 16, etc.).
                                      ' Since it must go in BH, we multiply
                                      ' by 256.

                                      ' BL (block to load) will be 0

    Registers.DX = FirstChar          ' DX = Offset to begin loading.  Example:
                                      ' -To replace Chr$(33) +, FirstChar = 33
                                      ' -To replace Chr$(224) +, FirstChar = 224

                                      '  NOTE:  You can begin loading ANYWHERE.
                                      '  The only caveat is that FirstChar +
                                      '  NumberChars CANNOT exceed 255.

    '====== just checking ...

    IF FirstChar + NumberChars > 255 THEN
       CLS : PRINT "Error in parameters.  Too many characters, or starting too high."
       END
    END IF


    '====== 2nd, locate our font:  its Segment and Address

    IF UsingFarStrings THEN           ' IF you're using QB 4.x, COMMENT OUT
                                      ' the next line.

       Registers.ES = SSEG(a$)        ' Segment if using QBX/BC7's FAR strings

    ELSE

       Registers.ES = VARSEG(a$)      ' Segment if using QB or BC7's NEAR strings

    END IF

    Registers.BP = SADD(a$)           ' The address of our string.


    '====== We're all set.  Now LOAD the font.

    Registers.AX = &H1100             ' Use Function 11h, Service 0 (Load)
                                      ' of Interrupt 10.
                                      ' AH = 11h - The function we want
                                      ' AL =   0 - Load user font

    InterruptX &H10, Registers, Registers   ' Invoke BIOS service 10 with CALL Interrupt


    '====== Now SET (or SELECT) it.

    Registers.AX = &H1103             ' Use Function 11h, Service 3 (Set)
                                      ' of Interrupt 10.

                                      ' AH = 11h - The function we want
                                      ' AL =   3 - Set (Select) our font

    Registers.BX = 0                  ' BL = Which block to load (parallels
                                      ' what we did above when loading it)

    InterruptX &H10, Registers, Registers    ' Invoke BIOS service 10h

END SUB

'
SUB PauseTicks (Ticks)


'...Routine to pause for ?? ticks.  From Larry Stone's PrintROM.Bas.

    DEF SEG = 0

    DO WHILE TestTick% < Ticks      'Pause for X ticks of the clock

        LastTick% = Tick%           'Compare w/ Tick to see if clock changed
        Tick% = PEEK(&H46C)         'Get a tick from the clock.

        IF LastTick% <> Tick% THEN TestTick% = TestTick% + 1

    LOOP


'... The version below gives a little more precision, but
'    works very differently on fast/slow PCs.

'    DEF SEG = 0                    '...we'll look in (Peek) low memory
'
'    DO UNTIL TestTick > Ticks
'
'        LastTick = GetTick
'
'        GetTick = PEEK(&H46C)      'Get a tick from the clock.
'
'        IF LastTick < GetTick + 1 THEN TestTick = TestTick + 1
'
'    LOOP




    '...back to normal in either case
    DEF SEG




END SUB

'
FUNCTION PressKey$ (Row, Col, Action)

    SHARED PressAKey$           '...share this to eliminate need to re-assign

    STATIC Offset               '...preserve between calls to use this in
                                '   "polled" mode

    '...Display a scrolling "Press any key to continue . . ."
    '   You MUST set the colors before invoking this!

    '...We separated this so we could call it from several places.
    '   This should also make it easier for you to use it elsewhere.


    '...ACTION determines whether this takes over, or just scrolls the
    '   message once and bails out (ie., works in "polled mode").
    '
    '   Action = 0        Take control, re-initialize Offset to 1 (start
    '                     display at beginning), wait for a keypress,
    '                     return the key pressed in PressKey$.
    '
    '            1        Re-set Offset to 1 (start display at beginning),
    '                     print PressAKey$ and exit.
    '
    '            2        Scoll PressAKey$ and exit.


    '... Should we reset to begin printing at the beginning?

    SELECT CASE Action

        CASE 0, 1: Offset = 0

    END SELECT

    Length = LEN(PressAKey$)

    DO


        Offset = Offset + 1
        IF Offset > LEN(PressAKey$) THEN Offset = 1

        '...display our prompt

        LOCATE Row, Col

        PRINT RIGHT$(PressAKey$, Length - Offset + 1); LEFT$(PressAKey$, Offset - 1);

        '... If we were called in "polled mode," exit.

        SELECT CASE Action
            CASE 1, 2: EXIT FUNCTION

        END SELECT


        '... don't use TIMER (and it's FP)

        '... PauseTicks has 2 versions
        CALL PauseTicks(3)

         'CALL PauseTicks(500)


        a$ = INKEY$


    LOOP UNTIL LEN(a$)

    '...return key pressed
    PressKey$ = a$

END FUNCTION

FUNCTION QB.Monitor (ScrnRows) STATIC

    '...Registers is a SHARED TYPE  (DIM SHARED Registers as RegTypeX)

'...Returns 2 Values:  1) the type of monitor being used      (QB.Monitor)
'                      2) the current number of screen lines  (ScrnRows)
'
'   Usage:
'
'           ScrnSegment = &HB800                '...assume color (we don't
'                                               '   use this, but you might
'                                               '   need it)
'
'           SELECT CASE QB.Monitor(ScrnRows)    '...note:  returns 2 values
'               Case 1: Print "Mono";
'                       ScrnSegment = &HB000    '...in case you need it
'               Case 2: Print "CGA";
'               Case 3: Print "EGA";
'               Case 4: Print "VGA";
'           END SELECT
'
'           Print " monitor detected, which currently has this many rows: ";ScrnRows


    ScrnRows = 25                           'assume 25 rows


    DEF SEG = 0

    IF PEEK(&H463) = &HB4 THEN              'Is it monochrome?

        QB.Monitor = 1                      'Yes, and we're outta here.

    ELSE                                    'It's Color (CGA, EGA or VGA)?

        '...If we got here, it's color.  2 CALLs
        '   will tell us if it's CGA, EGA or VGA.

        Registers.AX = &H1200               'Alternate Select service
                                            'This is a mixed bag of services

        Registers.BX = &H10                 'We'll use "Return EGA info"

        CALL InterruptX(&H10, Registers, Registers)

        '...If BL = 10h (16), it's CGA

        IF (Registers.BX AND &HFF) = &H10 THEN

           QB.Monitor = 2                   'CGA

        ELSE

           '...if we're here, it's EGA or VGA -- but which?   Here,
           '   we gotta know.

           QB.Monitor = 3                   'Assume EGA


           ScrnRows = PEEK(&H484) + 1       'Get # of rows on screen.
                                            'Adjust to 1-based.

            '... OK, it's either EGA or VGA.  But which?  Use Function
            '    1Ah to test for VGA --- since 1Ah is NOT supported on
            '    earlier adapters.  If AL (not AH) is 1Ah (26) AFTER
            '    this call, a VGA-compatible adapter is present.


            Registers.AX = &H1A00           'Display Combination Code  (the DCC)

            '...QB/QBX
            CALL InterruptX(&H10, Registers, Registers)


            IF Registers.AX MOD 256 = &H1A THEN

                QB.Monitor = 4               'It's VGA

            END IF

            '...For the sake of completeness ....

            '   On return from this call, BH holds a code indicating
            '   the **combination** of adapter and monitor -- the
            '   "Display Combination Code" or DCC.
            '
            '   If you need this info, here are possible DCC values: : :
            '
            '   BH  =  &H0  ---  "No display"
            '          &H1  ---  "IBM monochrome adapter AND display"
            '          &H2  ---  "IBM CGA adapter AND color display"
            '          &H3  ---  "This is reserved.  Don't know!"
            '          &H4  ---  "IBM EGA with a color display"
            '          &H5  ---  "IBM EGA, mono display"
            '          &H6  ---  "IBM PGA, color display"
            '          &H7  ---  "VGA, analog mono display"
            '          &H8  ---  "VGA, analog color display"
            '          &H9  ---  "This is reserved.  Don't know!"
            '          &HA  ---  "MCGA, digital color display"
            '          &HB  ---  "MCGA, analog mono display"
            '          &HC  ---  "MCGA, analog color display"
            '          &HFF ---  "Don't know!  Unknown monitor type."

        END IF

    END IF

DEF SEG


END FUNCTION

'
SUB RestoreDefault (WhichMonitor)

    '==== Restore the default font (16 or 14 for VGA/EGA respectively).

    SELECT CASE WhichMonitor

        CASE 4                          ' VGA or MCGA

            font = 4                    ' 8x16 Font

        CASE ELSE                       ' Assume EGA or an error in selecting

            font = 1                    ' 8x14 Font

    END SELECT


    CALL ToggleSize(font)

END SUB

'
SUB Sideways.Logo

    SHARED PressAKey$       '...in case you want to use it here


'...Display "Pro~Formance" (our company name) in several different
'   ways (sideways, upside down, etc.).


    CLS


    '...assign our strings

    Top$ = CHR$(255) + "  P R O ~ F O R M A N C E "     '255 is actually our
                                                        'Copyright/TM symbol
    Bottom$ = "  "


    '... When we "CALL PFLogo" below, we'll re-map Chr$(219) - Chr$(255)
    '    with our special font.
    '
    '    So we need strings using those characters.  Each of these spells
    '    "PRO~FORMANCE."  "Yeah, right" I can hear you mumble.  You'll see!

    FOR x = 219 TO 230
        RightSide$ = RightSide$ + CHR$(x)
        LeftSide$ = LeftSide$ + CHR$(x + 24)
        '...do the next one backwards
        Bottom$ = Bottom$ + CHR$(241 - x + 220) + " "
    NEXT

    Bottom$ = Bottom$ + " "
    RightSide$ = RightSide$ + " "
    LeftSide$ = LeftSide$ + " "


    '...Load our logo font, remapping Chr$(219) through Chr$(255).
    '   How do you know it's these characters being remapped?  Because
    '   that's the way I set up the CALL for this font (created using
    '   Font2Asm.

    CALL PFLogo


    TopRow = 4

    '...1st, print everything statically

    LOCATE 2, 27, 0: PRINT Top$
    LOCATE 23, 27: PRINT Bottom$;
    LOCATE 25, 19: PRINT "... Remember, this is ALL in TEXT mode! ...";

    LeftCol = 12
    RightSide = LeftCol + 53
    SideOffset = LEN(LeftSide$)
    GOSUB DoSides

    '...reset for everything else
    LeftCol = 20
    RightSide = LeftCol + 38

    '...display our box

    RESTORE LogoBox

    LOCATE TopRow
    FOR x = 1 TO 18     '... print our 12-line box

        READ a$: LOCATE , LeftCol: PRINT a$

    NEXT


    '...NOTE:  Commented-out lines will roll these in the opposite direction.

    Length = LEN(Top$)

    DO


       Offset = Offset + 1
       IF Offset > Length THEN Offset = 1

       '...Print the top line

       LOCATE TopRow + 1, LeftCol + 6
       PRINT " "; RIGHT$(Top$, Length - Offset + 1); " "; LEFT$(Top$, Offset - 1); " ";
         'PRINT " "; MID$(Top$, (Length - Offset + 1)); " "; LEFT$(Top$, (Length - Offset + 1)); " ";

       '...and our prompt  (Action = 2 means invoke PressKey$ in "polled" mode)

       COLOR 15, 1
       a$ = PressKey$(TopRow + 8, LeftCol + 6, 2)
       COLOR 15, 4

       '...and the bottom
       LOCATE TopRow + 16, LeftCol + 5
       PRINT " "; MID$(Bottom$, (Length - Offset + 1)); " "; LEFT$(Bottom$, (Length - Offset + 1)); " ";
         'PRINT " "; MID$(Bottom$, Offset); " "; LEFT$(Bottom$, Offset - 1); " ";

       '...and now the sides
       GOSUB DoSides

       '... don't use TIMER (and it's FP)

       '... PauseTicks has 2 versions
       CALL PauseTicks(3)
        'CALL PauseTicks(500)


    LOOP UNTIL LEN(INKEY$)


EXIT SUB

'=======================================
DoSides:    '...do the sides of our box
'=======================================

    '...NOTE:  Commented-out lines will roll these in the opposite direction

    FOR x = 1 TO 12     '...12 characters in "Pro~Formance"

        SideOffset = SideOffset - 1
        IF SideOffset < 1 THEN SideOffset = LEN(LeftSide$)

        'SideOffset = SideOffset + 1
        'IF SideOffset > LEN(LeftSide$) OR SideOffset < 1 THEN SideOffset = 1

        LOCATE TopRow + x + 2, LeftCol + 2
        'LOCATE TopRow + 15 - x, LeftCol + 2

        PRINT MID$(LeftSide$, SideOffset, 1);

        LOCATE TopRow + 15 - x, RightSide
        'LOCATE TopRow + x + 2, RightSide

        PRINT MID$(RightSide$, SideOffset, 1);

        CALL PauseTicks(1)
           'CALL PauseTicks(200)

    NEXT

RETURN

END SUB

'
SUB ToggleSize (Which)    '... "Which" MUST be:   1 (8x14) 2 (8x8) 4 (8x16)


    '...Registers is a SHARED TYPE  (DIM SHARED Registers as RegTypeX)

    '====== Switch among the 2-3 resident fonts (or restore the default).


    Registers.AX = &H1100 + Which     ' Use Function 11h, Service 0 (Load).
                                      '
                                      ' AH = 11h - The function we want
                                      ' AL = Which: 1 (8x14) 2 (8x8) 4 (8x16)

    Registers.BX = 0


    InterruptX &H10, Registers, Registers   ' Invoke BIOS service 10h


END SUB